home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / clipss.zip / SPRDSHT.PRG < prev    next >
Text File  |  1991-09-19  |  22KB  |  813 lines
  1. /*****
  2.  *
  3.  * SPRDSHT.PRG
  4.  * A TBrowse Spreadsheet
  5.  * Version 2.0 - September 1991
  6.  *
  7.  * Luiz F. Quintela
  8.  * Copyright (c) 1991 Nantucket Corporation.
  9.  *                    All Rights Reserved.
  10.  *
  11.  * Clipper 5.01 - Release 1.29
  12.  *
  13.  * WARNING: This program is based in a 80 column
  14.  *          screen. What, of course, can be easily
  15.  *          changed!
  16.  *
  17.  * RMAKE 789
  18.  *
  19.  */
  20.  
  21. #include "inkey.ch"
  22. #include "setcurs.ch"
  23. #include "error.ch"
  24. #include "sprdsht.ch"
  25.  
  26. /*****
  27.  *
  28.  * Main Function
  29.  *
  30.  */
  31.  
  32. FUNCTION Sheet(nWait)
  33.    LOCAL b, k, nKey, c, w, g
  34.    LOCAL column, nMaxRow, nMaxCol
  35.    LOCAL aBlocks[MAXLEN, 6]
  36.    LOCAL i, aInfo, aCalc, aTgON, aEdFo, aTgOF, aEdNu
  37.    LOCAL aCurtain
  38.    LOCAL lAutoCalc     := .T.
  39.    LOCAL lNeedToReCalc := .F.
  40.    // You cannot declare both arrays
  41.    // as LOCAL because we are using a macro
  42.    // to create the data retrieval block.
  43.    // If you want to avoid the macro, see comment below.
  44.    // The same applies to nSubscript.
  45.    MEMVAR aArray, aFormulas, nSubscript
  46.  
  47.    // Init
  48.    nWait   := IF(nWait != NIL, VAL(nWait), NIL)
  49.    nMaxRow := MAXROW()
  50.    nMaxCol := MAXCOLUMN
  51.    aArray     := ARRAY(MAXLEN, 6)
  52.    aFormulas  := ARRAY(MAXLEN, 6)
  53.    k          := 0
  54.    nSubscript := 1
  55.    nKey       := 0
  56.  
  57.    // Load Arrays
  58.    ReadSpreadSheet(aArray, VALUES)
  59.    ReadSpreadSheet(aFormulas, FORMULAS)
  60.  
  61.    // Calculate all formulas
  62.    Calculus(aArray, aFormulas, aBlocks)
  63.  
  64.    // Screen (section not handled by TBrowse)
  65.    // Save the "curtain"
  66.    aCurtain := SaveCurtain()
  67.  
  68.    SETCURSOR(SC_NONE)
  69.    SET SCOREBOARD OFF
  70.    SETBLINK(.F.)
  71.    PaintScreen()
  72.  
  73.    // Create buttons
  74.    aInfo := CreateButtom( nMaxRow - 2,  5, "^Info" )
  75.    aTgON := CreateButtom( nMaxRow - 2, 18, "^Autocalc ON " )
  76.    aTgOF := CreateButtom( nMaxRow - 2, 18, "^Autocalc OFF" )
  77.    aEdFo := CreateButtom( nMaxRow - 2, 39, "^Edit Formulas" )
  78.    aEdNu := CreateButtom( nMaxRow - 2, 39, "^Edit Numbers " )
  79.    aCalc := CreateButtom( nMaxRow - 2, 61, "^Calculate" )
  80.    // Paint buttoms
  81.    SelectButtom(aInfo)
  82.    SelectButtom(aEdFo)
  83.    SelectButtom(aTgON)
  84.    SelectButtom(aCalc)
  85.  
  86.    // TBrowse object for values
  87.    b := TBrowseNew( 3, 6, nMaxRow - 4, MAXCOLUMN - 2)
  88.    b:skipBlock := {|x| ;
  89.                   k := IF(ABS(x) >= IF(x >= 0,;
  90.                   MAXLEN - nSubscript, nSubscript - 1),;
  91.                   IF(x >= 0, MAXLEN - nSubscript,1 - nSubscript),;
  92.                   x), nSubscript += k,;
  93.                   k }
  94.    b:goTopBlock    := {|| nSubscript := 1}
  95.    b:goBottomBlock := {|| nSubscript := MAXLEN}
  96.    // Colour table for the browse object
  97.    b:colorSpec := COLORTABLE
  98.  
  99.    // Create each column
  100.    FOR i := 1 TO 6
  101.       column := TBColumnNew(,;
  102.                &("{|p| IF(p == NIL, VAL(STR(aArray[nSubscript," +;
  103.                LTRIM(STR(i)) + "],10,2)), aArray[nSubscript," +;
  104.                LTRIM(STR(i)) + "] := p)}"))
  105.       column:width := 11
  106.       column:colorBlock := {|x| IF(x < 0, {5,2},;
  107.                                 IF(x > 0, {8,2}, {4,2}))}
  108.       column:colSep := NOTHING
  109.       b:addColumn(column)
  110.  
  111.    NEXT
  112.    // You can create each column without macros
  113.    // repeating this code six times (1 to 6)
  114.    // column := TBColumnNew(,{|p| IF(p == NIL,;
  115.    //                       aArray[nSubscript,1],;
  116.    //                       aArray[nSubscript,1] := p)})
  117.    // column:width := 11
  118.    // b:addColumn(column)
  119.    //
  120.    // Doing so, you can declare aArray as LOCAL
  121.    // since it will not be macroed. Same applies to
  122.    // the nSubscript variable.
  123.  
  124.    // TBrowse object for formulas
  125.    c := TBrowseNew( 3, 6, nMaxRow - 4, MAXCOLUMN - 2)
  126.    // Skip Block
  127.    c:skipBlock := {|x| ;
  128.                   k := IF(ABS(x) >= IF(x >= 0,;
  129.                   MAXLEN - nSubscript, nSubscript - 1),;
  130.                   IF(x >= 0, MAXLEN - nSubscript,1 -;
  131.                   nSubscript), x), nSubscript += k,;
  132.                   k }
  133.    c:goTopBlock    := {|| nSubscript := 1}
  134.    c:goBottomBlock := {|| nSubscript := MAXLEN}
  135.    c:colorSpec := COLORTABLE
  136.  
  137.    // Create each column
  138.    FOR i := 1 TO 6
  139.       column := TBColumnNew(,;
  140.                &("{|p| IF(p == NIL, aFormulas[nSubscript," +;
  141.                LTRIM(STR(i)) + "], aFormulas[nSubscript," +;
  142.                LTRIM(STR(i)) + "] := p)}"))
  143.       column:width := 10
  144.       column:colSep := NOTHING
  145.       column:defColor := {5,7}
  146.       c:addColumn(column)
  147.  
  148.    NEXT
  149.    // You can create each column without macros
  150.    // repeating this code six times (1 to 6)
  151.    // column := TBColumnNew(,{|p| IF(p == NIL,;
  152.    //                       aFormulas[nSubscript,1],;
  153.    //                       aFormulas[nSubscript,1] := p)})
  154.    // c:addColumn(column)
  155.    //
  156.    // Doing so, you can declare aFormulas as LOCAL
  157.    // since it will not be macroed. Same applies to 
  158.    // nSubscript variable.
  159.  
  160.    // Current object will be data
  161.    w := b
  162.  
  163.    // Main loop
  164.    WHILE .T.
  165.       // Stabilize it!
  166.       // DispBegin() and DispEnd() are used to get rid
  167.       // of that line by line display
  168.       //
  169.       DISPBEGIN()
  170.       WHILE (!w:stabilize())
  171.       END
  172.       @ MAXROW(), 0;
  173.       SAY PADR( EVAL ( (c:getColumn(w:colPos)):block ),;
  174.                   MAXCOLUMN + 1 ) COLOR FIRSTLINE
  175.       DISPEND()
  176.       IF w:stable()
  177.          // The "Running Letters"
  178.          // and the "Screen Saver"
  179.          IF ((nKey := WhatKey( nWait, {|| Touchy()})) == 0)
  180.             ScreenBlanker()
  181.             // Repaint browse screen
  182.             w:invalidate()
  183.             LOOP
  184.  
  185.          ENDIF
  186.  
  187.       ENDIF
  188.       IF !MoveIt(nKey, w)
  189.          // Keystroke was not handled by MoveIt()
  190.          IF nKey == K_ENTER
  191.             IF (w == b) .AND. ;
  192.                !EMPTY(EVAL((c:getColumn(w:colPos)):block))
  193.                // Formula exists for this cell!
  194.                // Do not allow editing!
  195.                LOOP
  196.                // Edit current object
  197.                lNeedToReCalc := DoGet( w )
  198.  
  199.             ENDIF
  200.             // Edit current object
  201.             lNeedToReCalc := DoGet( w )
  202.             IF lAutoCalc .AND. lNeedToReCalc
  203.                // Evaluate all code blocks
  204.                CalcBlocks(aArray, aBlocks)
  205.                w:refreshAll()
  206.                lNeedToReCalc := .F.
  207.  
  208.             ENDIF
  209.  
  210.          ELSEIF nKey == K_ESC .OR. ;
  211.                nKey == K_ALT_X .OR. ;
  212.                nKey == K_ALT_F4
  213.             IF ExitBox( 8, 24, {|| Touchy()}, "Sprdsht",;
  214.                        nWait, {|| ScreenBlanker()} )
  215.                // Bye for now!
  216.                // Do not forget to save the work!
  217.                SaveValues(aArray)
  218.                SaveFormulas(aFormulas)
  219.                RestoreCurtain(aCurtain)
  220.                EXIT
  221.  
  222.             ENDIF
  223.  
  224.          ELSEIF nKey == ASC("E") .OR.;
  225.                nKey == ASC("e")
  226.             // Shift between Formulas/Values
  227.             IF (w == b)
  228.                // Entering EDIT FORMULAS mode
  229.                // turn Recalculation OFF
  230.                lAutoCalc := .F.
  231.                PressButtom(aEdFo)
  232.                SelectButtom(aEdNu)
  233.                SelectButtom(aTgOF)
  234.                w := c
  235.  
  236.             ELSE
  237.                // Entering EDIT NUMBERS mode
  238.                // turn Recalculation ON
  239.                lAutoCalc := .T.
  240.                // Rebuild all Codeblocks
  241.                //
  242.                Calculus(aArray, aFormulas, aBlocks)
  243.                PressButtom(aEdNu)
  244.                SelectButtom(aEdFo)
  245.                SelectButtom(aTgON)
  246.                w := b
  247.  
  248.             ENDIF
  249.             EVAL(w:goTopBlock)
  250.             w:refreshAll()
  251.  
  252.          ELSEIF nKey == ASC("C") .OR.;
  253.                nKey == ASC("c")
  254.             IF (w == b)
  255.                // Calculus, calculus, calculus...
  256.                PressButtom(aCalc)
  257.                Calculus(aArray, aFormulas, aBlocks)
  258.                w:refreshAll()
  259.  
  260.             ENDIF
  261.  
  262.          ELSEIF nKey == ASC("I") .OR.;
  263.                nKey == ASC("i")
  264.             PressButtom(aInfo)
  265.             NeedHelp( nWait, {|| Touchy()} )
  266.  
  267.          ELSEIF nKey == ASC("A") .OR.;
  268.                nKey == ASC("a")
  269.             // Disabled while in Edit Formulas mode
  270.             IF (w == b)
  271.                // Toggle Automatic Recalculation
  272.                // Be aware about one fact:
  273.                // Even if you turned Recalculation OFF,
  274.                // every time you enter in the editing vales mode
  275.                // recalculation will be turned ON!
  276.                //
  277.                lAutoCalc := !lAutocalc
  278.                IF lAutoCalc
  279.                   PressButtom(aTgON)
  280.  
  281.                ELSE
  282.                   PressButtom(aTgOF)
  283.  
  284.                ENDIF   
  285.  
  286.             ENDIF
  287.  
  288.          ENDIF
  289.  
  290.       ENDIF
  291.  
  292.    END
  293.    RETURN (NIL)
  294.  
  295. /*****
  296.  *
  297.  * Initialize array elements
  298.  *
  299.  */
  300.  
  301. STATIC FUNCTION ReadSpreadSheet(PointerToArray, ReadWhat)
  302.    // Since arrays are references
  303.    // Values stored into PointerToArray[x,y]
  304.    // are stored into the array above since
  305.    // arrays are always passed by reference
  306.    LOCAL k := 1
  307.  
  308.    IF ReadWhat == VALUES
  309.       IF FILE("SprdVal.dbf")
  310.          DBUSEAREA( .F., "DbfNtx", "SprdVal" )
  311.          // Load array from database
  312.          AEVAL(PointerToArray,;
  313.             {|x,i| IF(k != i,;
  314.             EVAL({|m| DBSKIP(), k := m }, i), NIL),;
  315.             AEVAL(x, {|y,j| ;
  316.             PointerToArray[k,j] := FIELDGET(j)})})
  317.          DBCLOSEAREA()
  318.  
  319.       ELSE
  320.          // Database not found!
  321.          // Initialize array elements
  322.          AEVAL(PointerToArray,;
  323.                {|x| AEVAL(x, { |y,j| ;
  324.                PointerToArray[k,j] := 0.00}),;
  325.                ++k})
  326.  
  327.       ENDIF
  328.  
  329.    ELSE
  330.       IF FILE("SprdFor.dbf")
  331.          DBUSEAREA( .F., "DbfNtx", "SprdFor" )
  332.          // Load array from database
  333.          AEVAL(PointerToArray,;
  334.             {|x,i| IF(k != i,;
  335.             EVAL({|m| DBSKIP(), k := m }, i), NIL),;
  336.             AEVAL(x, {|y,j| ;
  337.             PointerToArray[k,j] := FIELDGET(j) }) })
  338.          DBCLOSEAREA()
  339.  
  340.       ELSE
  341.          // Database not found!
  342.          // Initialize array elements
  343.          AEVAL(PointerToArray,;
  344.                { |x| AEVAL(x, { |y,j| ;
  345.                PointerToArray[k,j] := SPACE(30)}),;
  346.                ++k})
  347.  
  348.       ENDIF
  349.  
  350.    ENDIF
  351.    RETURN (NIL)
  352.  
  353. /*****
  354.  *
  355.  * Saves values to a database file
  356.  *
  357.  */
  358.  
  359. STATIC FUNCTION SaveValues(PointerToArray)
  360.    LOCAL aStructure, k
  361.    LOCAL lFile := .F.
  362.  
  363.    IF (lFile := !FILE("SprdVal.dbf"))
  364.       aStructure := { { "COL1", "Numeric", 10, 2 },;
  365.                     { "COL2", "Numeric", 10, 2 },;
  366.                     { "COL3", "Numeric", 10, 2 },;
  367.                     { "COL4", "Numeric", 10, 2 },;
  368.                     { "COL5", "Numeric", 10, 2 },;
  369.                     { "COL6", "Numeric", 10, 2 } }
  370.       DBCREATE("SprdVal", aStructure)
  371.  
  372.    ENDIF
  373.  
  374.    DBUSEAREA( .F., "DbfNtx", "SprdVal" )
  375.    ReplaceData(PointerToArray, lFile)
  376.    DBCLOSEAREA()
  377.    RETURN (NIL)
  378.  
  379. /*****
  380.  *
  381.  * Saves formulas to a database file
  382.  *
  383.  */
  384.  
  385. STATIC FUNCTION SaveFormulas(PointerToArray)
  386.    LOCAL aStructure, k
  387.    LOCAL lFile := .F.
  388.  
  389.    IF (lFile := !FILE("SprdFor.dbf"))
  390.       aStructure := { { "COL1", "Character", 30, 0 },;
  391.                     { "COL2", "Character", 30, 0 },;
  392.                     { "COL3", "Character", 30, 0 },;
  393.                     { "COL4", "Character", 30, 0 },;
  394.                     { "COL5", "Character", 30, 0 },;
  395.                     { "COL6", "Character", 30, 0 } }
  396.       DBCREATE("SprdFor", aStructure)
  397.  
  398.    ENDIF
  399.    DBUSEAREA( .F., "DbfNtx", "SprdFor" )
  400.    ReplaceData(PointerToArray, lFile)
  401.    DBCLOSEAREA()
  402.    RETURN (NIL)
  403.  
  404. /*****
  405.  *
  406.  * Actually replaces data into database file
  407.  *
  408.  */
  409.  
  410. STATIC FUNCTION ReplaceData(PointerToArray, lLogic)
  411.    LOCAL k
  412.    IF lLogic
  413.       k := 0
  414.       // Empty database
  415.       AEVAL(PointerToArray,;
  416.          {|x,i| IF(k != i, EVAL({|m| DBAPPEND(), k := m }, i),;
  417.          NIL),;
  418.          AEVAL(x, {|y,j| FIELDPUT(j, PointerToArray[k,j]) }) })
  419.  
  420.    ELSE
  421.       // Non-empty database
  422.       k := 1
  423.       AEVAL(PointerToArray,;
  424.          {|x,i| IF(k != i, EVAL({|m| DBSKIP(), k := m }, i),;
  425.          NIL),;
  426.          AEVAL(x, {|y,j| FIELDPUT(j, PointerToArray[k,j]) }) })
  427.  
  428.    ENDIF
  429.    RETURN (NIL)
  430.  
  431. /*****
  432.  *
  433.  * A nice display (I hope!)
  434.  *
  435.  */
  436.  
  437. STATIC FUNCTION Touchy()
  438.   LOCAL cStr  := PAGEHEADER
  439.   STATIC nCnt := 0
  440.   LOCAL nLen  := LEN(PAGEHEADER) - 1
  441.  
  442.   // Regular Line
  443.   @  0,12 SAY cStr COLOR FIRSTLINE
  444.   @  0,12 + nCnt SAY SUBSTR(cStr, nCnt + 1, 1) COLOR HEADCLR
  445.   IF (++nCnt > nLen)
  446.      nCnt := 0
  447.  
  448.   ENDIF
  449.   RETURN (NIL)
  450.  
  451. /*****
  452.  *
  453.  * Translates formula into a codeblock
  454.  *
  455.  */
  456.  
  457. STATIC FUNCTION ConvertIt(cToBeXlated)
  458.    LOCAL cXlated := NOTHING
  459.    LOCAL cTemp   := NOTHING
  460.    LOCAL nLen
  461.    LOCAL i := 1
  462.    LOCAL aXlateArray
  463.  
  464.    // Empty cell
  465.    IF EMPTY(cToBeXlated)
  466.       RETURN ("{|aArray| .T.}")
  467.  
  468.    ENDIF
  469.  
  470.    // Take spaces out
  471.    cToBeXlated := STRTRAN(cToBeXlated, " ", NOTHING)
  472.    nLen        := LEN(cToBeXlated)
  473.    aXlateArray := ARRAY(nLen)
  474.    // Transfer each character of the original string
  475.    // to an array element
  476.    AEVAL(aXlateArray, {|x,i| ;
  477.          aXlateArray[i] := SUBSTR(cToBeXlated,i,1)})
  478.    // Handle it
  479.    WHILE (i <= nLen)
  480.       IF ELEMENT $ "0123456789"
  481.          cTemp += ELEMENT
  482.  
  483.       ELSEIF ELEMENT $ "(/+-*)."
  484.          cTemp += ELEMENT
  485.  
  486.       ELSEIF ELEMENT == "A"
  487.          cTemp += "aArray["
  488.          cTemp += WhatItIs(aXlateArray, @i)
  489.          cTemp += ",1]"
  490.  
  491.       ELSEIF ELEMENT == "B"
  492.          cTemp += "aArray["
  493.          cTemp += WhatItIs(aXlateArray, @i)
  494.          cTemp += ",2]"
  495.  
  496.       ELSEIF ELEMENT == "C"
  497.          cTemp += "aArray["
  498.          cTemp += WhatItIs(aXlateArray, @i)
  499.          cTemp += ",3]"
  500.  
  501.       ELSEIF ELEMENT == "D"
  502.          cTemp += "aArray["
  503.          cTemp += WhatItIs(aXlateArray, @i)
  504.          cTemp += ",4]"
  505.  
  506.       ELSEIF ELEMENT == "E"
  507.          cTemp += "aArray["
  508.          cTemp += WhatItIs(aXlateArray, @i)
  509.          cTemp += ",5]"
  510.  
  511.       ELSEIF ELEMENT == "F"
  512.          cTemp += "aArray["
  513.          cTemp += WhatItIs(aXlateArray, @i)
  514.          cTemp += ",6]"
  515.  
  516.       ELSE
  517.          // Invalid Character
  518.          // Assume no formula given
  519.          cTemp := "{|aArray| .T.}"
  520.          EXIT
  521.  
  522.       ENDIF
  523.       ++i
  524.  
  525.    END
  526.    IF !("T" $ cTemp)
  527.       cTemp := "{|aArray| " + cTemp + "}"
  528.  
  529.    ENDIF
  530.    RETURN (cTemp)
  531.  
  532. STATIC FUNCTION WhatItIs(aXlateArray, i)
  533.    LOCAL cTemp := NOTHING
  534.    LOCAL nLen  := LEN(aXlateArray)
  535.  
  536.    i++
  537.    WHILE (ELEMENT $ "0123456789")
  538.       cTemp += aXlateArray[i++]
  539.       IF i > nLen
  540.          EXIT
  541.  
  542.       ENDIF
  543.  
  544.    END
  545.    --i
  546.    RETURN (cTemp)
  547.  
  548. /*****
  549.  *
  550.  * Calculus, calculus, calculus...
  551.  *
  552.  * Calculation is columnwise
  553.  * top to bottom
  554.  *
  555.  */
  556.  
  557. STATIC FUNCTION Calculus(aArray, aFor, aBlock)
  558.    LOCAL i, j, k, oOldHandler
  559.    // First build the codeblocks
  560.    // based in the formulas
  561.    // You can use FOR...NEXT
  562.    // or AEVAL()
  563.    // This one uses AEVAL()
  564.    //
  565.    // Avoid crashes!
  566.    // Just in case someone typed a "strange" formula
  567.    //
  568.    // Post your handler
  569.    oOldHandler := ERRORBLOCK({|e| Oops(e, oOldHandler)})
  570.    AEVAL(aFor, {|x,i| k := i,;
  571.          AEVAL(x, {|y,j| aBlock[k,j] := &(ConvertIt(y))})})
  572.    // Original handler
  573.    ERRORBLOCK(oOldHandler)
  574.    // Blocks built!
  575.    // This one uses FOR...NEXT
  576.    // to evaluate each one
  577.    //
  578.    CalcBlocks(aArray, aBlock)
  579.    RETURN (NIL)
  580.  
  581. /*****
  582.  *
  583.  * Evaluates array with codeblocks
  584.  *
  585.  */
  586.  
  587. STATIC FUNCTION CalcBlocks(aArray, aBlocks)
  588.    LOCAL i, j, k
  589.    //
  590.    // You can use AEVAL() in lieu of FOR...NEXT
  591.    //
  592.    FOR i := 1 TO MAXLEN
  593.       FOR j := 1 TO 6
  594.          k := EVAL(aBlocks[i,j], aArray)
  595.          IF VALTYPE(k) == "N"
  596.             // Force it to the size of 10
  597.             aArray[i,j] := VAL(STR(k,10,2))
  598.  
  599.          ENDIF
  600.  
  601.       NEXT
  602.  
  603.    NEXT
  604.    RETURN (NIL)
  605.  
  606. /*****
  607.  *
  608.  * Recovery against mistyped formulas
  609.  *
  610.  */
  611.  
  612. STATIC FUNCTION Oops(e, oOldHandler)
  613.    LOCAL oWhatsUpDoc
  614.    IF (e:operation $ "&") .AND.;
  615.       (e:genCode == EG_SYNTAX)
  616.       // Someone typed a wrong formula.
  617.       // Ignore the wrong one.
  618.       // Replace it with:
  619.       RETURN &("{|aArray| .T.}")
  620.  
  621.    ENDIF
  622.    // I DO NOT know what is going on!
  623.    // So, create an error object and 
  624.    // pass it to the old handler
  625.    // This case should not happen!
  626.    oWhatsUpDoc := ERRORNEW()
  627.    oWhatsUpDoc:description := "YourError() failed"
  628.    oWhatsUpDoc:severity    := ES_CATASTROPHIC     // Gosh!
  629.    oWhatsUpDoc:genCode     := 99
  630.    oWhatsUpDoc:subCode     := 9999
  631.    oWhatsUpDoc:operation   := "Problem found when replacing; "+;
  632.                              "a mistyped formula"
  633.    // Raise the error
  634.    RETURN EVAL(oOldHandler, oWhatsUpDoc)
  635.  
  636. /*****
  637.  *
  638.  * @...GET
  639.  *
  640.  */
  641.  
  642. STATIC FUNCTION DoGet( w )
  643.    LOCAL nCursSave
  644.    LOCAL column, get, nKey
  645.    LOCAL lNeedToCalc := .F.
  646.  
  647.    // make sure browse is stable
  648.    DISPBEGIN()
  649.    WHILE (!w:stabilize())
  650.    END
  651.    DISPEND()
  652.  
  653.    // get column object from browses
  654.    // based on its position
  655.    column := w:getColumn( w:colPos )
  656.  
  657.    // create a corresponding GET
  658.    get := GetNew(ROW(), COL(), column:block,;
  659.          column:heading,;
  660.          IF(VALTYPE(EVAL(column:block)) == "N",;
  661.          "@KR 9,999,999.99", "@!KS10"), "W+/RB")
  662.  
  663.    // read it
  664.    lNeedToCalc := ModalJr( get )
  665.  
  666.    // force redisplay of current row
  667.    w:refreshCurrent()
  668.  
  669.    SETCURSOR(SC_NONE)
  670.    RETURN (lNeedToCalc)
  671.  
  672. /*****
  673.  *
  674.  * This is a "junior" version of
  675.  * ReadModal()
  676.  *
  677.  */
  678.  
  679. STATIC FUNCTION ModalJr( get )
  680.    LOCAL lExitRequested       := .F.
  681.    LOCAL nKey, cKey, lUpdated := .F.
  682.  
  683.    SETCURSOR(IF(!SET(_SET_INSERT), SC_NORMAL, SC_SPECIAL1))
  684.    // In order to edit the Get you 
  685.    // should give it input focus
  686.    get:setFocus()
  687.  
  688.    // Check for editable positions
  689.    lExitRequested := get:typeOut
  690.  
  691.    // Keystroke processing loop
  692.    WHILE !lExitRequested
  693.       // Wait for a key and,
  694.       // keep the letters running
  695.       //
  696.       // WARNING: Pay special attention to the 
  697.       // codeblock sent to WhatKey(), since you
  698.       // are moving the cursor under Touchy().
  699.       // When you need variables LOCAL to the
  700.       // block, just declare some dummy parameters
  701.       //
  702.       nKey := WhatKey( , {|r, c, l| r := ROW(),;
  703.                                 c := COL(),;
  704.                                 l := SETCURSOR(SC_NONE),;
  705.                                 Touchy(),;
  706.                                 DEVPOS(r, c),;
  707.                                 SETCURSOR(l)} )
  708.       // Process It
  709.       IF (nKey == K_ESC)
  710.          // Abort!
  711.          get:undo()
  712.          get:reset()
  713.          RETURN (lUpdated)
  714.  
  715.       ELSEIF (nKey == K_ENTER)
  716.          // Normal termination
  717.          lExitRequested := .T.
  718.  
  719.       ELSEIF (nKey == K_CTRL_U)
  720.          get:undo()
  721.  
  722.       ELSEIF (nKey == K_RIGHT)
  723.          // Move cursor one position to the right 
  724.          get:right()
  725.  
  726.       ELSEIF (nKey == K_HOME)
  727.          // Move cursor to the left-most position
  728.          get:home()
  729.  
  730.       ELSEIF (nKey == K_END)
  731.          // Move cursor to the right-most position
  732.          get:end()
  733.  
  734.       ELSEIF (nKey == K_CTRL_RIGHT)
  735.          // Move cursor right one word
  736.          get:wordRight()
  737.  
  738.       ELSEIF (nKey == K_CTRL_LEFT)
  739.          // Move cursor left one word
  740.          get:wordLeft()
  741.  
  742.       ELSEIF (nKey == K_LEFT)
  743.          // Move cursor one position to the left
  744.          get:left()
  745.  
  746.       ELSEIF (nKey == K_DEL)
  747.          // Delete character under cursor
  748.          get:delete()
  749.  
  750.       ELSEIF (nKey == K_BS)
  751.          // Delete character to the left of the cursor
  752.          get:backSpace()
  753.  
  754.       ELSEIF (nKey == K_ALT_K)
  755.          // Delete from cursor until end of line
  756.          get:delEnd()
  757.  
  758.       ELSEIF (nKey == K_INS)
  759.          // Insert Key will toggle between insert/overstrike
  760.          SET(_SET_INSERT,!SET(_SET_INSERT))
  761.          SETCURSOR(IF(SET(_SET_INSERT), SC_SPECIAL1, SC_NORMAL))
  762.  
  763.       ELSE
  764.          // Data Keys
  765.          IF (nKey >= 32) .AND. (nKey <= 127)
  766.             cKey := CHR(nKey)
  767.             // Check for Numbers
  768.             IF (get:type == "N") .AND. ;
  769.                (cKey == "," .OR. cKey == ".")
  770.                get:toDecPos()
  771.                // Moves the cursor to the immediate position
  772.                // of the decimal point in the editing buffer
  773.  
  774.             ELSE
  775.                // Send it to Get
  776.                IF SET(_SET_INSERT)
  777.                   // Inserts character into the editing buffer
  778.                   // at the current cursor position, shifting
  779.                   // the existent contents of the buffer to the 
  780.                   // right
  781.                   get:insert(cKey)
  782.  
  783.                ELSE
  784.                   // Puts character into the editing buffer at the 
  785.                   // current cursor position, overwriting the
  786.                   // existent contents.
  787.                   get:overstrike(cKey)
  788.  
  789.                ENDIF
  790.  
  791.             ENDIF
  792.  
  793.          ENDIF
  794.  
  795.       ENDIF
  796.  
  797.    END
  798.  
  799.    IF (lUpdated := get:changed)
  800.       // Indicates wheater the get:buffer has changed
  801.       get:assign() // Assigns the value in the editing buffer to
  802.                   // the Get variable
  803.  
  804.    ENDIF
  805.    // resets the editing buffer to reflect the current value
  806.    get:reset()
  807.    // Take out input focus
  808.    get:killFocus()
  809.    SETCURSOR(SC_NONE)
  810.    RETURN (lUpdated)
  811.  
  812. // EOF - SPRDSHT.PRG //
  813.